home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1996 #14 / Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO / prog_d / hlp_wzrd.zip / EXPAND.PA$ < prev    next >
Text File  |  1995-11-18  |  5KB  |  152 lines
  1. {
  2.   Program: Expand
  3.   Date: 11/18/95
  4.   Purpose: To create a visual component library (vcl) for Delphi
  5. }
  6. Unit Expand;
  7.  
  8. interface
  9.  
  10. Uses
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, StdCtrls, Controls,
  12.   Forms, Dialogs, Menus, DsgnIntf, About, LZExpand;
  13.  
  14. type
  15.   TCommand = (cmYes, cmNo);
  16.   TOverwrite = (owAlways, owAsk, owNever);
  17.   TOverwriteEvent = procedure(const FileName: String; var Command: TCommand) of object;
  18.   EExpandFileBad = class(Exception);
  19.   EExpandFileNotFound = class(Exception);
  20.   EExpandNoFiles = class(Exception);
  21.  
  22. { TExpand }
  23.  
  24.   TExpand = class(TComponent)
  25.   private
  26.     { Private declarations }
  27.     FAbout: TAbout;
  28.     FFilesToProcess: TStrings;
  29.     FExtractDirectory: String;
  30.     FExpandedFileName: String;
  31.     FMoveFiles: Boolean;
  32.     FOverwrite: TOverwrite;
  33.     FOnNextFile: TNotifyEvent;
  34.     FOnOverwrite: TOverwriteEvent;
  35.     function GetFilesToProcess: TStrings;
  36.     procedure SetFilesToProcess(Value: TStrings);
  37.     procedure SetOverwrite(Value: TOverwrite);
  38.   protected
  39.     { Protected declarations }
  40.   public
  41.     { Public declarations }
  42.     constructor Create(AOwner: TComponent); override;
  43.     destructor Destroy; override;
  44.     function Extract: Integer;
  45.   published
  46.     { Published declarations }
  47.     property About: TAbout read FAbout write FAbout stored False;
  48.     property FilesToProcess: TStrings read GetFilesToProcess write SetFilesToProcess stored True;
  49.     property ExtractDirectory: String read FExtractDirectory write FExtractDirectory stored True;
  50.     property ExpandedFileName: String read FExpandedFileName;
  51.     property MoveFiles: Boolean read FMoveFiles write FMoveFiles stored True;
  52.     property Overwrite: TOverwrite read FOverwrite write SetOverwrite stored True;
  53.     property OnNextFile: TNotifyEvent read FOnNextFile write FOnNextFile;
  54.     property OnOverwrite: TOverwriteEvent read FOnOverwrite write FOnOverwrite;
  55.   end;
  56.  
  57. procedure Register;
  58.  
  59. implementation
  60.  
  61. { TExpand }
  62.  
  63. constructor TExpand.Create(AOwner: TComponent);
  64. begin
  65.   inherited Create(AOwner);
  66.   FOverwrite:=owAsk;                    { Default 'owAsk' }
  67.   FFilesToProcess:=TStringList.Create;
  68.   LZStart;
  69.   FilesToProcess:=nil;
  70. end;
  71.  
  72. function TExpand.GetFilesToProcess: TStrings;
  73. begin
  74.   Result := FFilesToProcess;
  75. end;
  76.  
  77. procedure TExpand.SetFilesToProcess(Value: TStrings);
  78. begin
  79.   if Value<>nil then FFilesToProcess.Assign(Value);
  80. end;
  81.  
  82. procedure TExpand.SetOverwrite(Value: TOverwrite);
  83. begin
  84.   if Value<>FOverwrite then FOverwrite:=Value;
  85. end;
  86.  
  87. destructor TExpand.Destroy;
  88. begin
  89.   FFilesToProcess.Free;
  90.   LZDone;
  91.   inherited Destroy;
  92. end;
  93.  
  94. function TExpand.Extract: Integer;
  95. var I:Integer;
  96.     CommpressFileName,ExpandFileName:array [0..79] of Char;
  97.     ReOpenBuff:TOfStruct;
  98.     hCompressFile:Integer;
  99.     hExpandFile:Integer;
  100.     Cmd:TCommand;
  101. begin
  102.   if FFilesToProcess.Count>0 then
  103.     for I:=0 to Pred(FFilesToProcess.Count) do
  104.     begin
  105.       { Open the Commpressed file }
  106.       StrPCopy(CommpressFileName,FFilesToProcess.Strings[I]);
  107.       hCompressFile:=LZOpenFile(CommpressFileName,ReOpenBuff,of_Read);
  108.       if hCompressFile<>-1 then
  109.         begin
  110.           { Open the Expanded file }
  111.           GetExpandedName(CommpressFileName,ExpandFileName);
  112.           FExpandedFileName:=ExtractFileName(StrPas(ExpandFileName));
  113.           if Length(FExtractDirectory)>3 then StrPCopy(ExpandFileName,FExtractDirectory+'\')
  114.                                          else StrPCopy(ExpandFileName,FExtractDirectory);
  115.           StrPCopy(@ExpandFileName[StrLen(ExpandFileName)],FExpandedFileName);
  116.           { Fire Event Next file }
  117.           if Assigned(FOnNextFile) then FOnNextFile(Self);
  118.           Cmd:=cmYes;  { Default return = Overwrite }
  119.           { If overwrite then Fire Event Overwrite }
  120.           if (FOverwrite=owAsk)and
  121.              (FileExists(StrPas(ExpandFileName)))and
  122.              (Assigned(FOnOverwrite)) then FOnOverwrite(StrPas(ExpandFileName),Cmd);
  123.           if (not FileExists(StrPas(ExpandFileName)))or
  124.              (FOverwrite=owAlways)or((FOverwrite=owAsk)and(Cmd=cmYes)) then
  125.           begin
  126.             hExpandFile:=LZOpenFile(ExpandFileName,ReOpenBuff,of_Create);
  127.             { DeCommpress the files }
  128.             if LZCopy(hCompressFile,hExpandFile)<0 then
  129.                raise EExpandFileBad.Create('Insufficient space or memory, or source file is bad.');
  130.             { Close compressed and expanded files }
  131.             LZClose(hCompressFile);
  132.             LZClose(hExpandFile);
  133.             { Delete compressed file if need (move) }
  134.             if FMoveFiles then DeleteFile(FFilesToProcess.Strings[I]);
  135.           end else LZClose(hCompressFile);
  136.         end
  137.       else
  138.        raise EExpandFileNotFound.Create('File not found '+FFilesToProcess.Strings[I]);
  139.     end
  140.   else
  141.     raise EExpandNoFiles.Create('No files to decompress');
  142. end;
  143.  
  144. procedure Register;
  145. begin
  146.   RegisterComponents('Wizard', [TExpand]);
  147.   RegisterPropertyEditor(TypeInfo(TAbout), nil, '', TAboutProperty);
  148. end;
  149.  
  150. begin
  151. end.